Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/atileg1a/frmtilet.frm

Visual Basic Form | 1999-09-29 | 15KB | 471 lines

VERSION 5.00
Begin VB.Form frmTileTest
   Caption         =   "Map Creation"
   ClientHeight    =   9420
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   10440
   LinkTopic       =   "Form1"
   ScaleHeight     =   628
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   696
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton vmdAbout
      Caption         =   "About"
      Height          =   375
      Left            =   150
      TabIndex        =   20
      Top             =   90
      Width           =   1155
   End
   Begin VB.PictureBox imgZoom
      Height          =   915
      Left            =   180
      ScaleHeight     =   855
      ScaleWidth      =   945
      TabIndex        =   19
      Top             =   540
      Width           =   1005
   End
   Begin VB.PictureBox Outer
      Height          =   6675
      Left            =   30
      ScaleHeight     =   441
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   345
      TabIndex        =   15
      Top             =   1500
      Width           =   5235
      Begin VB.HScrollBar HScroll1
         Height          =   255
         LargeChange     =   5
         Left            =   0
         Max             =   200
         TabIndex        =   18
         Top             =   7830
         Width           =   7905
      End
      Begin VB.VScrollBar VScroll1
         Height          =   8085
         LargeChange     =   5
         Left            =   7920
         Max             =   200
         TabIndex        =   17
         Top             =   0
         Width           =   285
      End
      Begin VB.PictureBox Inner
         BackColor       =   &H00FF0000&
         FillColor       =   &H00FF0000&
         Height          =   79650
         Left            =   0
         ScaleHeight     =   5306
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   4746
         TabIndex        =   16
         Top             =   0
         Width           =   71250
         Begin VB.Image imgSml
            Height          =   15
            Left            =   4200
            Top             =   5550
            Width           =   15
         End
         Begin VB.Image castle
            Height          =   720
            Index           =   0
            Left            =   690
            Picture         =   "frmTileTest.frx":0000
            Stretch         =   -1  'True
            Top             =   720
            Visible         =   0   'False
            Width           =   720
         End
         Begin VB.Image imgTile
            Appearance      =   0  'Flat
            BorderStyle     =   1  'Fixed Single
            Height          =   1440
            Index           =   0
            Left            =   0
            Picture         =   "frmTileTest.frx":3042
            Stretch         =   -1  'True
            Tag             =   "0"
            Top             =   0
            Width           =   1440
         End
      End
   End
   Begin VB.Frame Frame2
      Caption         =   "File"
      Height          =   1185
      Left            =   3510
      TabIndex        =   9
      Top             =   60
      Width           =   1995
      Begin VB.CommandButton Command1
         Caption         =   "Save"
         Height          =   255
         Left            =   390
         TabIndex        =   12
         Top             =   840
         Width           =   1125
      End
      Begin VB.CommandButton Command2
         Caption         =   "Load"
         Height          =   285
         Left            =   390
         TabIndex        =   11
         Top             =   540
         Width           =   1125
      End
      Begin VB.TextBox txtFile
         Height          =   285
         Left            =   930
         TabIndex        =   10
         Text            =   "out"
         Top             =   210
         Width           =   975
      End
      Begin VB.Label Label4
         AutoSize        =   -1  'True
         Caption         =   "Filename :"
         Height          =   195
         Left            =   180
         TabIndex        =   13
         Top             =   240
         Width           =   720
      End
   End
   Begin VB.Frame Frame1
      Caption         =   "Misc :"
      Height          =   975
      Left            =   5700
      TabIndex        =   5
      Top             =   180
      Width           =   1875
      Begin VB.TextBox Text1
         Height          =   285
         Left            =   1170
         TabIndex        =   7
         Text            =   "4"
         Top             =   240
         Width           =   555
      End
      Begin VB.CheckBox chkGrid
         Caption         =   "Grid On"
         Height          =   285
         Left            =   270
         TabIndex        =   6
         Top             =   600
         Value           =   1  'Checked
         Width           =   945
      End
      Begin VB.Label Label2
         AutoSize        =   -1  'True
         Caption         =   "Zoom Factor:"
         Height          =   195
         Left            =   180
         TabIndex        =   8
         Top             =   270
         Width           =   945
      End
   End
   Begin VB.Frame fmGridSize
      Caption         =   "Grid Size :"
      Height          =   1365
      Left            =   1380
      TabIndex        =   0
      Top             =   30
      Width           =   1965
      Begin VB.CommandButton cmdClear
         Caption         =   "Clear"
         Height          =   315
         Left            =   300
         TabIndex        =   14
         Top             =   960
         Width           =   1485
      End
      Begin VB.CommandButton cmdResize
         Caption         =   "Change Size"
         Height          =   285
         Left            =   300
         TabIndex        =   4
         Top             =   630
         Width           =   1455
      End
      Begin VB.TextBox txtCol
         Height          =   375
         Left            =   1200
         TabIndex        =   2
         Text            =   "20"
         Top             =   240
         Width           =   555
      End
      Begin VB.TextBox txtRow
         Height          =   375
         Left            =   240
         TabIndex        =   1
         Text            =   "20"
         Top             =   240
         Width           =   555
      End
      Begin VB.Label Label3
         AutoSize        =   -1  'True
         Caption         =   "by"
         Height          =   195
         Left            =   900
         TabIndex        =   3
         Top             =   330
         Width           =   165
      End
   End
   Begin VB.Image imgArrow
      Height          =   480
      Left            =   8700
      Picture         =   "frmTileTest.frx":3884
      Top             =   240
      Visible         =   0   'False
      Width           =   480
   End
Attribute VB_Name = "frmTileTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' The main form,
' Click on a texture in the texture's form and then on a cell in this form to
' place it.
Option Explicit
Private CONSTPath As String
Const SEAPic = 53
Private ActiveTile As Integer
Private ZoomLevel As Double
Private Map As Map
'Private Tile(400) As Tile
Private ImageLoaded As Boolean
Private Sub castle_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, y As Single)
  castle(Index).Drag vbBeginDrag
End Sub
Private Sub chkGrid_Click()
Dim i As Integer
  If chkGrid.Value = vbChecked Then
    For i = 0 To Map.Rows * Map.Cols - 1
      imgTile(i).BorderStyle = 1
    Next
  Else
    For i = 0 To Map.Rows * Map.Cols - 1
      imgTile(i).BorderStyle = 0
    Next
  End If
End Sub
Private Sub cmdClear_Click()
Dim i As Integer
  For i = 0 To Map.Rows * Map.Cols - 1
    imgTile(i).Picture = frmTextures.picTile(SEAPic).Picture
    Map(i).Image = SEAPic
  Next
End Sub
Private Sub cmdResize_Click()
Dim i As Integer
  'Set Map = New Map